home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / minimuf1.zip / MINIMUF.BAS < prev    next >
BASIC Source File  |  1990-10-14  |  8KB  |  228 lines
  1. 10 REM - SAMPLE DRIVER FOR MINIMUF 3.5
  2. 12 REM  FROM QST DECEMBER 1982 PAGE 36
  3. 14 REM  Article By Robert B. Rose, K6GKU
  4. 16 REM  With modifications shown in August, 1983 QST, Page 64.  --N6KL
  5. 18 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  6. 20 REM * Interface and output routines rewritten on 3/3/87 
  7. 22 REM * MINIMUF 3.5 (lines 1000-2000) was not changed
  8. 24 REM * Martin R. Maltby, Arcata, CA, x6xxx  (no call yet!)
  9. 26 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  10. 100 REM
  11. 102 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  12. 104 REM *                  I N I T I A L I Z A T I O N
  13. 106 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  14. 108 CLEAR 1000
  15. 110 U$="          ##:00         ##.#                   ##:00         ##.#
  16. 112 DIM MUF(23)
  17. 114 DATA 31,28,31,30,31,30,31,31,30,31,30,31 'Days in months
  18. 116 M$="JanFebMarAprMayJunJulAugSepOctNovDec"
  19. 118 PI = 3.1415926535#
  20. 120 R0=PI/180
  21. 122 P1=2*PI
  22. 124 R1=180/PI
  23. 126 P0=PI/2
  24. 200 REM
  25. 202 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  26. 204 REM *                    M A I N ,   I N P U T S
  27. 206 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  28. 208 CLS
  29. 210 PRINT "Transmitter latitute  ="
  30. 212 PRINT "Transmitter longitude ="
  31. 214 PRINT
  32. 216 PRINT "Receiver latitude     ="
  33. 218 PRINT "Receiver longitude    ="
  34. 220 PRINT
  35. 222 PRINT "Solar flux from WWV   ="
  36. 224 PRINT "ON DATE: Month Number ="
  37. 226 PRINT "         Day Number   ="
  38. 228 LOCATE 1,25:PRINT "                                 ":LOCATE 1,25
  39. 230 LINE INPUT TE$:L1=VAL(TE$)
  40. 232 IF L1=>-90 AND L1<=90 THEN 240
  41. 234 ER$= "Invalid latitude.  Must be in range -90 TO +90." : GOSUB 3100
  42. 236 GOTO 228
  43. 238 REM ----------------------------
  44. 240 LOCATE 2,25:PRINT "                                 ":LOCATE 2,25
  45. 242 LINE INPUT TE$: W1=VAL(TE$)
  46. 244 IF -360<=W1 AND W1<=360 THEN 252
  47. 246 ER$= "Invalid longitude.  Must be in range -360 TO +360." : GOSUB 3100
  48. 248 GOTO 240
  49. 250 REM ----------------------------
  50. 252 LOCATE 4,25:PRINT "                                 ":LOCATE 4,25
  51. 254 LINE INPUT TE$:L2=VAL(TE$)
  52. 256 IF -90<=L2 AND L2<=90 THEN 264
  53. 258 ER$= "Invalid latitude.  Must be in range -90 TO +90." : GOSUB 3100
  54. 260 GOTO 252
  55. 262 REM ----------------------------
  56. 264 LOCATE 5,25:PRINT "                                 ":LOCATE 5,25
  57. 266 LINE INPUT TE$: W2=VAL(TE$)
  58. 268 IF -360<=W2 AND W2<=360 THEN 276
  59. 270 ER$= "Invalid longitude.  Must be in range -360 TO +360." : GOSUB 3100
  60. 272 GOTO 264
  61. 274 REM -------------------------------------------------------
  62. 276 LOCATE 7,25:PRINT "                                 ":LOCATE 7,25
  63. 278 LINE INPUT TE$:S9=VAL(TE$)
  64. 280 IF S9=>60 THEN 286
  65. 282 ER$= "Invalid solar flux.  Must be greater then 60." : GOSUB 3100
  66. 284 GOTO 276
  67. 286 IF S9<250 THEN 294
  68. 288 ER$= "Invalid solar flux.  Must be less than 250." : GOSUB 3100
  69. 290 GOTO 276
  70. 292 REM CALCULATE SUNSPOT NUMBER FROM 10.7 CM SOLAR FLUX NUMBER.
  71. 294 S9=(S9-60)/.9000001
  72. 296 REM ----------------------------
  73. 298 LOCATE 8,25:PRINT "                                 ":LOCATE 8,25
  74. 300 LINE INPUT TE$:M0=VAL(TE$)
  75. 302 IF 1<=M0 AND M0<=12 THEN 308
  76. 304 ER$= "Invalid month, must be in range 1 TO 12.": GOSUB 3100
  77. 306 GOTO 298
  78. 308 LOCATE 9,25:PRINT "                                 ":LOCATE 9,25
  79. 310 LINE INPUT TE$:D6=VAL(TE$)
  80. 312 RESTORE : FOR Z=1 TO M0 : READ DY : NEXT Z
  81. 314 IF D6>=1 AND D6 <= DY THEN 328
  82. 316 ER$= "Invalid day.  Must be in range: 1 to "+STR$(DY)+"." : GOSUB 3100
  83. 318 GOTO 308
  84. 320 REM
  85. 322 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  86. 324 REM *                    M A I N ,    O U T P U T S
  87. 326 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  88. 328 A$=MID$(M$,3*M0-2,3)
  89. 330 CLS : PRINT "Date: ";D6;A$"          Sunspot number : "S9
  90. 332 PRINT "Transmitter location:  ";
  91. 334 PRINT "Latitude ";L1;" Longitude ";W1
  92. 336 PRINT "Receiver location:     ";
  93. 338 PRINT "Latitude ";L2;" Longitude ";W2
  94. 340 PRINT
  95. 342 PRINT "        Hour (UTC)    MUF (MHz)              Hour (UTC)    MUF (MHz)"
  96. 344 PRINT
  97. 346 L1=L1*R0
  98. 348 W1=W1*R0
  99. 350 L2=L2*R0
  100. 352 W2=W2*R0
  101. 354 FOR TE=0 TO 11
  102. 356    T5 = TE : GOSUB 1000 : MUF(T5)=J9
  103. 358    T5=TE+12: GOSUB 1000 : MUF(T5)=J9
  104. 360    PRINT USING U$;TE,MUF(TE),TE+12,MUF(TE+12)
  105. 362 NEXT TE
  106. 364 PRINT:PRINT
  107. 366 PRINT "PRESS: <Shift><PrtSc> to print, or <X> to exit";
  108. 368 A$ = INKEY$: IF A$ = "" THEN 368
  109. 370 IF (A$<>"x") AND (A$<>"X")  THEN 208
  110. 372 END
  111. 1000 REM
  112. 1010 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  113. 1020 REM *                    M I N I M U F   3 . 5
  114. 1030 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  115. 1040 REM *  REQUIRES:
  116. 1050 REM *
  117. 1060 REM *  L1, W1 = Transmitter Lattitude*(PI/180), Longitude*(PI/180)
  118. 1070 REM *  L2, W2 = Reciever Lattitude*(PI/180), Longitude*(PI/180)
  119. 1080 REM *  S9 = "sunspot number from 10.7 cm solar flux number"
  120. 1090 REM *
  121. 1100 REM *  M0 = Month # 
  122. 1110 REM *  D6 = Day #
  123. 1120 REM *  T5 = Hour #
  124. 1130 REM *
  125. 1140 REM *
  126. 1150 REM *  RETURNS: MUF for hour(T5) in J9
  127. 1160 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  128. 1170 REM - MINIMUF 3.5
  129. 1180 K7=SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W2-W1)
  130. 1190 IF K7=>-1 THEN 1220
  131. 1200 K7=-1
  132. 1210 GOTO 1240
  133. 1220 IF K7<=1 THEN 1240
  134. 1230 K7=1
  135. 1240 G1=1.5708-2*ATN(K7/(1+SQR(1-K7*K7)))
  136. 1250 K6=1.59*G1
  137. 1260 IF K6>=1 THEN 1280
  138. 1270 K6=1
  139. 1280 K5=1/K6
  140. 1290 J9=100
  141. 1300 FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP .9999-1/K6
  142. 1310     IF K5=1 THEN 1330
  143. 1320     K5=.5
  144. 1330     P=SIN(L2)
  145. 1340     Q=COS(L2)
  146. 1350     A=(SIN(L1)-P*COS(G1))/(Q*SIN(G1))
  147. 1360     B=G1*K1
  148. 1370     C=P*COS(B)+Q*SIN(B)*A
  149. 1380     D=(COS(B)-C*P)/(Q*SQR(1-C^2))
  150. 1390   IF D=>-1 THEN 1420
  151. 1400     D=-1
  152. 1410   GOTO 1440
  153. 1420   IF D<=1 THEN 1440
  154. 1430     D=1
  155. 1440     D=1.5708-2*ATN(D/(1+SQR(1-D*D)))
  156. 1450     W0=W2+SGN(SIN(W1-W2))*D
  157. 1460   IF W0=>0 THEN 1480
  158. 1470     W0=W0+P1
  159. 1480   IF W0<P1 THEN 1500
  160. 1490     W0=W0-P1
  161. 1500   IF C=>-1 THEN 1530
  162. 1510     C=-1
  163. 1520   GOTO 1550
  164. 1530   IF C<=1 THEN 1550
  165. 1540     C=1
  166. 1550     L0=P0-(1.5708-2*ATN(C/(1+SQR(1-C*C))))
  167. 1560     Y1=.0172*(10+(M0-1)*30.4+D6)
  168. 1570     Y2=.409*COS(Y1)
  169. 1580     K8=3.82*W0+12+.13*(SIN(Y1)+1.2*SIN(2*Y1))
  170. 1590   IF COS(L0+Y2)>-.26 THEN 1680
  171. 1600     K9=0
  172. 1610     G0=0
  173. 1620     M9=2.5*G1*K5
  174. 1630   IF M9<=P0 THEN 1650
  175. 1640     M9=P0
  176. 1650     M9=SIN(M9)
  177. 1660     M9=1+2.5*M9*SQR(M9)
  178. 1670   GOTO 1930
  179. 1680     K9=(-.26+SIN(Y2)*SIN(L0))/(COS(Y2)*COS(L0)+9.999999E-04)
  180. 1690     K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.639437
  181. 1700     T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
  182. 1710     T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
  183. 1720     C0=ABS(COS(L0+Y2))
  184. 1730     T9=9.7*C0^9.600001
  185. 1740   IF T9>0 THEN 1760
  186. 1750     T9=.1
  187. 1760     M9=2.5*G1*K5
  188. 1770   IF M9<P0 THEN 1790
  189. 1780     M9=P0
  190. 1790     M9=SIN(M9)
  191. 1800     M9=1+2.5*M9*SQR(M9)
  192. 1810   IF T4<T THEN 1840
  193. 1820   IF (T5-T)*(T4-T5)>0 THEN 1850
  194. 1830   GOTO 1980
  195. 1840   IF (T5-T4)*(T-T5)>0 THEN 1980
  196. 1850     T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
  197. 1860     G9=3.14159*(T6-T)/K9
  198. 1870     G8=3.14159*T9/K9
  199. 1880     U=(T-T6)/T9
  200. 1890     G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
  201. 1900     G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
  202. 1910   IF G0=>G7 THEN 1930
  203. 1920     G0=G7
  204. 1930     G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
  205. 1940     G2=G2*(1-.1*EXP((K9-24)/3))
  206. 1950     G2=G2*(1+(1-SGN(L1)*SGN(L2))*.1)
  207. 1960     G2=G2*(1-.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
  208. 1970   GOTO 2040
  209. 1980     T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
  210. 1990     G8=3.14159*T9/K9
  211. 2000     U=(T4-T6)/2
  212. 2010     U1=-K9/T9
  213. 2020     G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
  214. 2030   GOTO 1930
  215. 2040   IF G2>J9 THEN 2060
  216. 2050     J9=G2
  217. 2060 NEXT K1
  218. 2070 RETURN
  219. 3000 REM ummmm, OUTPUT ROUTINES
  220. 3100 LOCATE 22,1:BEEP
  221. 3110 PRINT ER$
  222. 3120 PRINT "-= Press any key to continue =-"
  223. 3130 IF INKEY$=""  THEN 3130
  224. 3140 LOCATE 22,1
  225. 3150 PRINT"                                                                   "
  226. 3160 PRINT"                                  "
  227. 3170 RETURN
  228.